ZED Projekt z analizy danych

1 Podsumowanie

TBA

2 Przygotowanie srodowiska i danych

2.1 Import bibliotek

library(xlsx)
library(DT)
library(knitr)
library(dplyr)
library(tidyr)
library(janitor)
library(imputeTS)
library(lares)
library(plotly)
library(caret)
library(qgraph)
library(ggforce)

2.2 Wczytanie i wstepna analiza danych

2.2.1 Wczytanie danych

raw_data <- read.xlsx(filename, 1)
raw_data <- as_tibble(raw_data)
dim(raw_data)

## [1] 6120   81

2.2.2 Krótka analiza surowych danych

Pierwsze 500 wierszy ze zbioru:

---

Podstawowe statystyki dla calego zbioru:

---

Podstawowe statystyki dla poszczegolnych atrybutow:

2.3 Transformacja danych

2.3.1 Wstepne czyszczenie danych

Wstepne czyszczenie danych:

• uzupelnienie kolumny PATIENT_ID
  
• usuniecie pustych wierszy i kolumn
  
• zmiana nazw kolumn

#raw_data[raw_data==-1]<-NA

#filling PATIENT_ID
id_filled <- raw_data %>% fill(PATIENT_ID)

#remove rows where all variables are empty
vars <- colnames(id_filled)[-(1:7)]
no_empty_rows<- id_filled[rowSums(is.na(id_filled[vars])) != length(vars), ]
no_empty_cols <- no_empty_rows[colSums(!is.na(no_empty_rows)) > 0]

#renaming columns
colnames_cleaned <- no_empty_cols %>% clean_names()

2.3.2 Brakujace wartosci

Eliminacja brakujących wartości na poziomie pacjenta obejmowała:

• interpolację, jeżeli w kolumnie były co najmniej dwie wartości niebędące NA
• stała wartość, jezeli w kolumnie byla dokladnie jedna wartość niebędąca NA

Jeżeli żadne z powyższych rozwiązań nie było możliwe, wartości NA zostawiono.

clean_NA<-function(column){
  not_NA_count<-sum(!is.na(column))
  if (not_NA_count>=2){ #interpolate
    column <- na_interpolation(column, option = "linear")
    column
  }

  else if (not_NA_count==1){ #constant value
    val <- first(na.omit(column))
    column[is.na(column)] <- val
    column
  }#default: leave NA values
  column
}

#for each patient:
# for each column:
#  clean_NA
cleaned<- colnames_cleaned%>% group_by(patient_id) %>% mutate_each(list(clean_NA))

#extract columns with attributes only
attributes<-cleaned[-(1:7)]

3 Wyczyszczone dane - podsumowanie

3.1 Przeglad danych

Podsumowanie zbioru:

Parametr	Wartosc
Liczba pacjentów	360
Liczba pomiarów	6106
Srednia liczba pomiarów na pacjenta	17
K	212
M	149
Smierc	195
Wypisanie ze szpitala	166
Liczba wierszy	81
Liczba zmiennych	74
Procent brakujacych wartosci	7

---

Wykresy prezentujące podział danych ze względu na płeć i wynik:

---

Wykres obrazujący czasy przyjęcia i wypisania lub śmierci z wyróżnieniem płci:

***

Tabela pokazująca 30 pierwszych rekordow po wyczyszczeniu danych:

3.2 Analiza wartosci atrybutow

Podsumowanie każdego z atrybutów:

---

Histogramy przedstawiajace rozklad atrybutow:

3.3 Korelacja miedzy danymi

Poniższy graf przedstawia korelację pomiędzy parami atrybutów. Grubość lini łączącej dwa atrybuty jest zależna od współczynnika korelacji, natomiast kolor oznacza korelację dodatnią (kolor zielony) lub ujemną (kolor czerwony)

---

Wykres przedstawiający 20 par atrybutów z największą korelacją:

3.4 Zmiana [atrybutu/ow] w czasie

Interaktywny wykres lub animację prezentującą zmianę wybranych atrybutów w czasie.

to wywalic:

timeline_plot <- ggplot() + 
    coord_cartesian() +
    scale_color_hue() +
    layer(data=cleaned, 
          mapping=aes(
              x=re_date, 
              y=hypersensitive_cardiac_troponin_i, group=patient_id
              ), 
          stat="identity", 
          geom="point", 
          position=
              position_jitter()
    )
ggplotly(timeline_plot)

to wywalic:

timeline_plot <- ggplot(cleaned, aes(x=re_date, y=serum_chloride, colour=factor(patient_id), group=patient_id))  + geom_line() + geom_point() + facet_wrap(~outcome)
ggplotly(timeline_plot)

Poniższy wykres przedstawia średnie wartości atrybutów hemoglobin (poziom hemoglobiny we krwi) oraz glucose (poziom glukozy we krwi) dla poszczególnych dni pobytu pacjenta w szpitalu. Celem wykresu jest próba pokazania zmiany tych atrybutów w czasie hospitalizacji, czyli z założenia najcięższego przebiegu choroby.

## `summarise()` regrouping output by 'id' (override with `.groups` argument)

## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

4 Klasyfikator

klasyfikator przewidujący czy dany pacjent przeżyje (w tej sekcji należy wykorzystać wiedzę z pozostałych punktów oraz wykonać dodatkowe czynności, które mogą poprawić trafność predykcji); dobór parametrów modelu oraz oszacowanie jego skuteczności powinny zostać wykonane za pomocą techniki podziału zbioru na dane uczące, walidujące i testowe; trafność klasyfikacji powinna zostać oszacowana na podstawie kliku wybranych (i uzasadnionych) miar oceny klasyfikacji.

ml_data<- cleaned%>%group_by(patient_id)%>%summarise_all(funs(last))
ml_data<-na_mean(ml_data) #TO ZROBIC OSOBNO DLA ZBIORU TESTUJACEGO I UCZACEGO!
#rozwazyc: usuniecie tych kolumn (wierszy), w których jest dużo wartosci NA (np. powyżej 40%?)

#ml_data$outcome=as.factor(ml_data$outcome)

ml_data$outcome=factor(ml_data$outcome, 
                        labels = make.names(c("negative", "positive")))


inTraining <- 
    createDataPartition(
        # atrybut do stratyfikacji
        y = ml_data$outcome,
        # procent w zbiorze uczącym
        p = .75,
        # chcemy indeksy a nie listę
        list = FALSE)
training <- ml_data[ inTraining,]
testing <- ml_data[ -inTraining,]

ctrl <- trainControl(
    method = "repeatedcv",
    number = 2,
    repeats = 5)


fit <- train(outcome ~ .,
             data = training,
             method = "rf",
             trControl = ctrl,
             ntree = 10)
rfClasses <- predict(fit, newdata = testing)
confusionMatrix(data = rfClasses, testing$outcome)

ml_data$outcome=factor(ml_data$outcome, 
                        labels = make.names(levels(ml_data$outcome)))

rfGrid <- expand.grid(mtry = 10:30)
gridCtrl <- trainControl(
    method = "repeatedcv",
    summaryFunction = twoClassSummary,
    classProbs = TRUE,
    number = 2,
    repeats = 5)


fitTune <- train(outcome ~ .,
             data = training,
             method = "rf",
             metric = "ROC",
             preProc = c("center", "scale"),
             trControl = gridCtrl,
             tuneGrid = rfGrid,
             ntree = 30)
rfTuneClasses <- predict(fitTune,
                         newdata = testing)
confusionMatrix(data = rfTuneClasses, 
                testing$outcome)

ggplot(fitTune) + theme_bw()

4.0.1 Analizę ważności atrybutów najlepszego znalezionego modelu

4.1 Dodatkowa analiza

analiza typowa dla danych klinicznych, np.:

• regresja logistyczna wraz z wzięciem pod uwagę czynników zakłócających (ang. confounding factors)
  
• regresja Coxa (ang. Cox Proportional-Hazards Model).